Use key-description for canonical keys

This takes the idea in the previous commit and translates the
representations of keys in the alists to be the output of
key-description. The issue is that `M-x` for example has two
representations with listify-key-sequence, but only one (it seems) from
key-description.

diff --git a/which-key.el b/which-key.el
index fc82da92e909f85850d4393fc0d9b016d165e7dd..b72de6f545cd9a495103b4c5ec9bd3eb12751382 100644 (file)
--- a/which-key.el
+++ b/which-key.el
@@ -400,15 +400,15 @@ variable.")
 
 (defvar which-key-prefix-name-alist '()
   "An alist with elements of the form (key-sequence . prefix-name).
-key-sequence is a sequence of the sort produced by applying `kbd'
-then `listify-key-sequence' to create a canonical version of the
-key sequence. prefix-name is a string.")
+key-sequence is a sequence of the sort produced by applying
+`key-description' to create a canonical version of the key
+sequence. prefix-name is a string.")
 
 (defvar which-key-prefix-title-alist '()
   "An alist with elements of the form (key-sequence . prefix-title).
-key-sequence is a sequence of the sort produced by applying `kbd'
-then `listify-key-sequence' to create a canonical version of the
-key sequence. prefix-title is a string. The title is displayed
+key-sequence is a sequence of the sort produced by applying
+`key-description' to create a canonical version of the key
+sequence. prefix-title is a string. The title is displayed
 alongside the actual current key sequence when
 `which-key-show-prefix' is set to either top or echo.")
 
@@ -470,7 +470,7 @@ set too high) and setup which-key buffer."
   (when (or (eq which-key-show-prefix 'echo)
             (eq which-key-popup-type 'minibuffer))
     (which-key--setup-echo-keystrokes))
-  (which-key--check-key-based-alist)
+  ;; (which-key--check-key-based-alist)
   ;; (which-key--setup-undo-key)
   (which-key--init-buffer)
   (setq which-key--is-setup t))
@@ -509,35 +509,35 @@ starter kit for example."
 ;;       (which-key-define-key-recursively
 ;;        map (kbd which-key-undo-key) 'which-key-undo))))
 
-(defun which-key--check-key-based-alist ()
-  "Check (and fix if necessary) `which-key-key-based-description-replacement-alist'"
-  (let ((alist which-key-key-based-description-replacement-alist)
-        old-style res)
-    (dolist (cns alist)
-      (cond ((listp (car cns))
-             (push cns res))
-            ((stringp (car cns))
-             (setq old-style t)
-             (push (cons (listify-key-sequence (kbd (car cns))) (cdr cns)) res))
-            ((symbolp (car cns))
-             (let (new-mode-alist)
-               (dolist (cns2 (cdr cns))
-                 (cond ((listp (car cns2))
-                        (push cns2 new-mode-alist))
-                       ((stringp (car cns2))
-                        (setq old-style t)
-                        (push (cons (listify-key-sequence (kbd (car cns2))) (cdr cns2))
-                              new-mode-alist))))
-               (push (cons (car cns) new-mode-alist) res)))
-            (t (message "which-key: there's a problem with the \
-entry %s in which-key-key-based-replacement-alist" cns))))
-    (setq which-key-key-based-description-replacement-alist res)
-    (when old-style
-      (message "which-key: \
- `which-key-key-based-description-replacement-alist' has changed format and you\
- seem to be using the old format. Please use the functions \
-`which-key-add-key-based-replacements' and \
-`which-key-add-major-mode-key-based-replacements' instead."))))
+;; (defun which-key--check-key-based-alist ()
+;;   "Check (and fix if necessary) `which-key-key-based-description-replacement-alist'"
+;;   (let ((alist which-key-key-based-description-replacement-alist)
+;;         old-style res)
+;;     (dolist (cns alist)
+;;       (cond ((listp (car cns))
+;;              (push cns res))
+;;             ((stringp (car cns))
+;;              (setq old-style t)
+;;              (push (cons (listify-key-sequence (kbd (car cns))) (cdr cns)) res))
+;;             ((symbolp (car cns))
+;;              (let (new-mode-alist)
+;;                (dolist (cns2 (cdr cns))
+;;                  (cond ((listp (car cns2))
+;;                         (push cns2 new-mode-alist))
+;;                        ((stringp (car cns2))
+;;                         (setq old-style t)
+;;                         (push (cons (listify-key-sequence (kbd (car cns2))) (cdr cns2))
+;;                               new-mode-alist))))
+;;                (push (cons (car cns) new-mode-alist) res)))
+;;             (t (message "which-key: there's a problem with the \
+;; entry %s in which-key-key-based-replacement-alist" cns))))
+;;     (setq which-key-key-based-description-replacement-alist res)
+;;     (when old-style
+;;       (message "which-key: \
+;;  `which-key-key-based-description-replacement-alist' has changed format and you\
+;;  seem to be using the old format. Please use the functions \
+;; `which-key-add-key-based-replacements' and \
+;; `which-key-add-major-mode-key-based-replacements' instead."))))
 
 ;; Default configuration functions for use by users. Should be the "best"
 ;; configurations
@@ -584,15 +584,15 @@ bottom."
   (when (or (not (stringp key)) (not (stringp value)))
     (error "which-key: Error %s (key) and %s (value) should be strings"
            key value))
-  (let ((key-lst (listify-key-sequence (kbd key))))
-    (cond ((null alist) (list (cons key-lst value)))
-          ((assoc key-lst alist)
-           (when (not (string-equal (cdr (assoc key-lst alist)) value))
+  (let ((keys (key-description (kbd key))))
+    (cond ((null alist) (list (cons keys value)))
+          ((assoc-string keys alist)
+           (when (not (string-equal (cdr (assoc-string keys alist)) value))
              (message "which-key: changing %s name from %s to %s in the %s alist"
-                      key (cdr (assoc key-lst alist)) value alist-name)
-             (setcdr (assoc key-lst alist) value))
+                      key (cdr (assoc-string keys alist)) value alist-name)
+             (setcdr (assoc-string keys alist) value))
            alist)
-          (t (cons (cons key-lst value) alist)))))
+          (t (cons (cons keys value) alist)))))
 
 ;;;###autoload
 (defun which-key-add-key-based-replacements (key-sequence replacement &rest more)
@@ -641,11 +641,11 @@ Add title for KEY-SEQ-STR given by TITLE. FORCE, if non-nil, will
 add the new title even if one already exists. KEY-SEQ-STR should
 be a key sequence string suitable for `kbd' and TITLE should be a
 string."
-  (let ((key-seq-lst (listify-key-sequence (kbd key-seq-str))))
+  (let ((keys (key-description (kbd key-seq-str))))
     (if (and (null force)
-             (assoc key-seq-lst which-key-prefix-title-alist))
+             (assoc-string keys which-key-prefix-title-alist))
         (message "which-key: Prefix title not added. A title exists for this prefix.")
-      (push (cons key-seq-lst title) which-key-prefix-title-alist))))
+      (push (cons keys title) which-key-prefix-title-alist))))
 
 ;;;###autoload
 (defun which-key-declare-prefixes (key-sequence name &rest more)
@@ -1103,30 +1103,31 @@ replacement occurs return the new STRING."
            (when key-str
              (listify-key-sequence (kbd key-str))))))
 
-(defun which-key--maybe-replace-prefix-name (key-lst desc)
-  "KEY-LST is a list of keys produced by `listify-key-sequences'
-and DESC is the description that is possibly replaced using the
-`which-key-prefix-name-alist'. Whether or not a replacement
-occurs return the new STRING."
+(defun which-key--maybe-replace-prefix-name (keys desc)
+  "KEYS is a list of keys produced by `listify-key-sequences' and
+`key-description'. DESC is the description that is possibly
+replaced using the `which-key-prefix-name-alist'. Whether or not
+a replacement occurs return the new STRING."
   (let* ((alist which-key-prefix-name-alist)
-         (canonical-key-lst (listify-key-sequence (kbd (key-description key-lst))))
-         (res (assoc canonical-key-lst alist))
+         (res (assoc-string keys alist))
          (mode-alist (assq major-mode alist))
-         (mode-res (when mode-alist (assoc canonical-key-lst mode-alist))))
+         (mode-res (when mode-alist
+                     (assoc-string keys mode-alist))))
     (cond (mode-res (cdr mode-res))
           (res (cdr res))
           (t desc))))
 
-(defun which-key--maybe-get-prefix-title (key-lst)
-  "KEY-LST is a list of keys produced by `listify-key-sequences'.
+(defun which-key--maybe-get-prefix-title (keys)
+  "KEYS is a string produced by `key-description'.
 A title is possibly returned using `which-key-prefix-title-alist'.
 An empty stiring is returned if no title exists."
-  (if key-lst
+  (if keys
       (let* ((alist which-key-prefix-title-alist)
-             (res (assoc key-lst alist))
+             (res (assoc-string keys alist))
              (mode-alist (assq major-mode alist))
-             (mode-res (when mode-alist (assoc key-lst mode-alist)))
-             (binding (key-binding (apply #'vector key-lst)))
+             (mode-res (when mode-alist
+                         (assoc-string keys mode-alist)))
+             (binding (key-binding keys))
              (alternate (when (and binding (symbolp binding))
                           (symbol-name binding))))
         (cond (mode-res (cdr mode-res))
@@ -1137,19 +1138,19 @@ An empty stiring is returned if no title exists."
                     (eq which-key-side-window-location 'bottom)
                     echo-keystrokes)
                (if alternate alternate
-                 (concat "Following " (key-description key-lst))))
+                 (concat "Following " keys)))
               (t "")))
     "Top-level bindings"))
 
-(defun which-key--maybe-replace-key-based (string key-lst)
-  "KEY-LST is a list of keys produced by `listify-key-sequences'
+(defun which-key--maybe-replace-key-based (string keys)
+  "KEYS is a string produced by `key-description'
 and STRING is the description that is possibly replaced using the
 `which-key-key-based-description-replacement-alist'. Whether or
 not a replacement occurs return the new STRING."
   (let* ((alist which-key-key-based-description-replacement-alist)
-         (str-res (assoc key-lst alist))
+         (str-res (assoc-string keys alist))
          (mode-alist (assq major-mode alist))
-         (mode-res (when mode-alist (assoc key-lst mode-alist))))
+         (mode-res (when mode-alist (assoc-string keys mode-alist))))
     (cond (mode-res (cdr mode-res))
           (str-res (cdr str-res))
           (t string))))
@@ -1246,7 +1247,6 @@ alists. Returns a list (key separator description)."
               (orig-desc (cdr key-desc-cons))
               (group (which-key--group-p orig-desc))
               (keys (which-key--current-key-string key))
-              (key-lst (which-key--current-key-list key))
               (local (eq (which-key--safe-lookup-key local-map (kbd keys))
                          (intern orig-desc)))
               (hl-face (which-key--highlight-face orig-desc))
@@ -1254,9 +1254,9 @@ alists. Returns a list (key separator description)."
                     key which-key-key-replacement-alist))
               (desc (which-key--maybe-replace
                      orig-desc which-key-description-replacement-alist))
-              (desc (which-key--maybe-replace-key-based desc key-lst))
+              (desc (which-key--maybe-replace-key-based desc keys))
               (desc (if group
-                        (which-key--maybe-replace-prefix-name key-lst desc)
+                        (which-key--maybe-replace-prefix-name keys desc)
                       desc))
               (key-w-face (which-key--propertize-key key))
               (desc-w-face (which-key--propertize-description
@@ -1520,7 +1520,7 @@ enough space based on your settings and frame size." prefix-keys)
              (status-left (propertize (format "%s/%s" (1+ page-n) n-pages)
                                       'face 'which-key-separator-face))
              (status-top (propertize (which-key--maybe-get-prefix-title
-                                      (which-key--current-key-list))
+                                      (which-key--current-key-string))
                                      'face 'which-key-note-face))
              (status-top (concat status-top
                                  (when (< 1 n-pages)